perm filename IMPULS.SAI[REV,MUS] blob sn#291752 filedate 1977-07-02 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00017 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	ENTRY
C00004 00003	DEFINE DISPLAY_WIDTH=769, DW=DISPLAY_WIDTH ∂ Should have prime DW
C00005 00004	INTERNAL RECORD_CLASS REV_STATE_LIST(
C00007 00005	INTERNAL PROCEDURE add_unit(
C00011 00006	INTERNAL PROCEDURE free_cascade(
C00013 00007	INTERNAL PROCEDURE fill_buffer(
C00016 00008	INTERNAL PROCEDURE IMPULS(
C00018 00009	   PROCEDURE next_sample(
C00019 00010	   RECORD_POINTER(REV_STATE_LIST) PROCEDURE init_list(
C00026 00011	   PROCEDURE init_sample(
C00030 00012	   SIMPLE PROCEDURE draw(
C00031 00013	   PROCEDURE init_draw(
C00033 00014	∂ Description of display algorithm.
C00036 00015	   INTEGER s,d,q,
C00038 00016	   END   "impuls"
C00039 00017	END   "IMPULSE"
C00050 ENDMK
C⊗;
ENTRY;
BEGIN "IMPULSE"
REQUIRE "HEADER.SAI" SOURCE_FILE;

∂ Ken Shoemake.  December 1976.
This module is for generating displays of impulse responses for
cascades of reverberators.  The displays are generated in a buffer
which may be shown on a DPY or printed in hard copy.

As an auxiliary to doing displays, routines are included for defining
the concept of a cascade.  Also here is a routine to reverberate a
cascade with given input buffer into an output buffer.
;
DEFINE DISPLAY_WIDTH=769, DW=DISPLAY_WIDTH; ∂ Should have prime DW;
DEFINE DISPLAY_HEIGHT=300, DH=DISPLAY_HEIGHT;
DEFINE LO_X=128-512, LO_Y=150,
      HI_X=LO_X+DW, HI_Y=LO_Y+DH;
DEFINE PER_LINE=24;
DEFINE TEXT_COL=HI_X-250, TEXT_ROW=HI_Y-PER_LINE;

DEFINE BUFSIZ=4096;

REQUIRE "JAMLIB[SUB,SYS]" LIBRARY;

EXTERNAL RECORD_CLASS REV_UNIT(
   INTEGER NUMBER_OF_SAMPLES, CLOCK_RATE;
   REAL GAIN, DELAY_TIME, DECAY_TIME);

EXTERNAL REAL PROCEDURE get_spec(
       RECORD_POINTER(REV_UNIT) revrb;
       STRING which_spec);

INTERNAL RECORD_CLASS REV_STATE_LIST(
   RECORD_POINTER(REV_STATE_LIST) NEXT_UNIT;
   REAL ARRAY DELAY_MEM; INTEGER MEM_SIZE, MEM_POSITION; REAL GAIN);

INTERNAL RECORD_CLASS CASCADE(
   INTEGER CLOCK_RATE;
   RECORD_POINTER(REV_STATE_LIST) FIRST_UNIT);

∂ These record structures are fairly uncomplicated structures,
	being merely a list of saved parameters for calls on APR for
	one particular path thru a reverberator tree.  A picture:

		+---------------+-------+
		|		| first	|
		|  clock rate	|  unit	|
		|		|   |	|
		+---------------+---|---+
				    |
				   \|/
		+-----+-----------------------------+
		|next | 		    	    |
		|unit | Saved parameters for unit 1 |
		|  |  |			    	    |
		+--|--+-----------------------------+
		   |
		  \|/
		+-----+-----------------------------+
		|next |			    	    |
		|unit |	Saved parameters for unit 2 |
		|  |  |			    	    |
		+--|--+-----------------------------+
		   |
		  \|/
		+-----+-----------------------------+
		|next |			    	    |
		|unit |	Saved parameters for unit 3 |
		|  |  |			    	    |
		+--|--+-----------------------------+
		   |
		   |
		  \|/
		   .
		   .
		   .

;
INTERNAL PROCEDURE add_unit(
      REFERENCE RECORD_POINTER(CASCADE) chain;
      RECORD_POINTER(REV_UNIT) unit);
∂ Add a unit reverberator to the given cascade, creating a cascade if
necessary.  Sample rates must match.
;
   BEGIN "add unit"
   RECORD_POINTER(REV_STATE_LIST) added;
   INTEGER size;
   DEFINE new_array(name,lower_bound,upper_bound)=⊂
      BEGIN
      REAL ARRAY proxy[lower_bound:upper_bound];
      MEMORY[LOCATION(name)] ← MEMORY[LOCATION(proxy)];
      MEMORY[LOCATION(proxy)] ← 0;
      END⊃;
   DEFINE error(range)=⊂PRINT(↓,"add_unit: ",range,↓)⊃;

   IF
      unit = NULL_RECORD
    THEN BEGIN
      error("unit ≠ null_record");
      RETURN;
      END;

   IF
      chain = NULL_RECORD
    THEN BEGIN
      chain ← NEW_RECORD(CASCADE);
      CASCADE:FIRST_UNIT[chain] ← NULL_RECORD;
      CASCADE:CLOCK_RATE[chain] ← 0;
      END;

   IF
      CASCADE:FIRST_UNIT[chain] = NULL_RECORD
    THEN
      CASCADE:CLOCK_RATE[chain] ← get_spec(unit,"rate")
    ELSE
      IF
         CASCADE:CLOCK_RATE[chain] ≠ get_spec(unit,"rate")
       THEN BEGIN
         error("Rates must be consistent");
         RETURN;
         END;
   added ← NEW_RECORD(REV_STATE_LIST);
   REV_STATE_LIST:MEM_SIZE[added] ← size ← get_spec(unit,"#samples");
   new_array(REV_STATE_LIST:DELAY_MEM[added],1,size);
   REV_STATE_LIST:GAIN[added] ← get_spec(unit,"gain");
   REV_STATE_LIST:MEM_POSITION[added] ← 0;
   REV_STATE_LIST:NEXT_UNIT[added] ← CASCADE:FIRST_UNIT[chain];
   CASCADE:FIRST_UNIT[chain] ← added;
   END   "add unit";
INTERNAL PROCEDURE free_cascade(
      REFERENCE RECORD_POINTER(CASCADE) chain);
∂ Deallocates the space associated with the given cascade, setting its
argument to NULL_RECORD.
;
   BEGIN "free cascade"
   RECORD_POINTER(REV_STATE_LIST) freed, remaining;

   ∂ PROCEDURE TO CALL A RECORD'S HANDLER PROCEDURE;
   EXTERNAL RECORD_POINTER(ANY_CLASS) PROCEDURE $RECFN(
         INTEGER OP;
         RECORD_POINTER(ANY_CLASS) R);

   ∂ OP VALUES FOR $RECFN;
   DEFINE ALLOCATE_RECORD = 1;
   DEFINE MARK_SUBFIELDS = 4;
   DEFINE DELETE_RECORD = 5;

   IF
      chain = NULL_RECORD
    THEN
      RETURN;

   freed ← CASCADE:FIRST_UNIT[chain];
   WHILE
      freed ≠ NULL_RECORD
    DO BEGIN
      remaining ← REV_STATE_LIST:NEXT_UNIT[freed];
      $RECFN(DELETE_RECORD,freed);
      freed ← remaining;
      END;

   $RECFN(DELETE_RECORD,chain);
   chain ← NULL_RECORD;
   END   "free cascade";
INTERNAL PROCEDURE fill_buffer(
      RECORD_POINTER(REV_STATE_LIST) rsl;
      REFERENCE REAL in_buffer, out_buffer;
      INTEGER size);
∂ Using the composite reverberator state remembered in rsl, continues
to reverberate with a fresh input buffer and output buffer.  Only
monophonic of course.
;
   BEGIN "fill buffer"
   EXTERNAL PROCEDURE APR(
	 REFERENCE REAL input_buffer_origin, output_buffer_origin;
         INTEGER buffer_size;
         REFERENCE REAL delay_memory_origin; INTEGER delay_size;
         REAL gain; REFERENCE INTEGER position_in_delay_memory);

   IF
      rsl = NULL_RECORD
    THEN BEGIN
      ARRBLT(out_buffer,in_buffer,size);
      RETURN;
      END;
   APR(in_buffer,out_buffer,size,
      REV_STATE_LIST:DELAY_MEM[rsl][1],
      REV_STATE_LIST:MEM_SIZE[rsl],
      REV_STATE_LIST:GAIN[rsl],
      REV_STATE_LIST:MEM_POSITION[rsl]);
   WHILE
      REV_STATE_LIST:NEXT_UNIT[rsl] ≠ NULL_RECORD
    DO BEGIN
      rsl ← REV_STATE_LIST:NEXT_UNIT[rsl];
      APR(out_buffer,out_buffer,size,
         REV_STATE_LIST:DELAY_MEM[rsl][1],
         REV_STATE_LIST:MEM_SIZE[rsl],
         REV_STATE_LIST:GAIN[rsl],
         REV_STATE_LIST:MEM_POSITION[rsl]);
      END;
   END   "fill buffer";
INTERNAL PROCEDURE IMPULS(
      REFERENCE INTEGER id; 
      RECORD_POINTER(CASCADE) rev_chain;
      REAL duration);
∂ Using standard JAM display package, allocate a buffer for display if
one does not exist and fill it with a graph of the impulse response of
the cascade over the given duration.
;
   BEGIN "impuls"

   EXTERNAL PROCEDURE DSETUP(INTEGER nwds; REFERENCE INTEGER id);
   DEFINE DGET(id,nwds)=⊂DSETUP(nwds,id)⊃;
   EXTERNAL BOOLEAN PROCEDURE DRELS(REFERENCE INTEGER id);
   EXTERNAL PROCEDURE WRITE(INTEGER id,pog);
   EXTERNAL PROCEDURE BUFCLR(INTEGER id,nwds);
   EXTERNAL PROCEDURE AVECT(INTEGER id,X,Y);
   EXTERNAL PROCEDURE AIVECT(INTEGER id,X,Y);
   EXTERNAL PROCEDURE RVECT(INTEGER id,dX,dY);
   EXTERNAL PROCEDURE RIVECT(INTEGER id,dX,dY);
   EXTERNAL PROCEDURE AXIS(INTEGER id;
         REAL vmin,vmax;
         REFERENCE REAL scale,offset;
         INTEGER pos,min,max;
         BOOLEAN xaxis);
   EXTERNAL PROCEDURE DTEXT(INTEGER id;
	 STRING text;
	 REAL scale(0), angle(0));

   PROCEDURE next_sample(
         REFERENCE REAL biggest_sample;
         RECORD_POINTER(REV_STATE_LIST) state_list;
         REFERENCE INTEGER sample_index);
      BEGIN "next sample"

      PRELOAD_WITH [BUFSIZ] 0.0;
      OWN REAL ARRAY ZEROS[1:BUFSIZ];
      OWN REAL ARRAY buf[1:BUFSIZ];

      IF
         sample_index > BUFSIZ
       THEN BEGIN
         fill_buffer(state_list,ZEROS[1],buf[1],BUFSIZ);
         sample_index ← 1;
         END;
      biggest_sample ← biggest_sample MAX ABS buf[sample_index];
      sample_index ← sample_index+1;
      END   "next sample";

   RECORD_POINTER(REV_STATE_LIST) PROCEDURE init_list(
         RECORD_POINTER(CASCADE) rev);
      BEGIN "init list"
      RECORD_POINTER(REV_STATE_LIST) rev_chain;

      IF
         rev = NULL_RECORD
       THEN
         RETURN(NULL_RECORD);

      rev_chain ← CASCADE:FIRST_UNIT[rev];
      WHILE
         rev_chain ≠ NULL_RECORD
       DO BEGIN
         IF
            REV_STATE_LIST:MEM_POSITION[rev_chain] ≠ 0
          THEN BEGIN
            ARRCLR(REV_STATE_LIST:DELAY_MEM[rev_chain]);
            REV_STATE_LIST:MEM_POSITION[rev_chain] ← 0;
            END;
         rev_chain ← REV_STATE_LIST:NEXT_UNIT[rev_chain];
         END;
      RETURN(CASCADE:FIRST_UNIT[rev]);
      END   "init list";
   PROCEDURE init_sample(
         RECORD_POINTER(CASCADE) rev;
         REFERENCE REAL scale;
         REFERENCE RECORD_POINTER(REV_STATE_LIST) state_list;
         REFERENCE INTEGER index);
      BEGIN "init sample"
      REAL ONE; ONE ← 1.0; ∂ For use as REFERENCE argument;
      state_list ← init_list(rev);
      fill_buffer(state_list,ONE,scale,1);
      scale ← ABS scale;
      index ← BUFSIZ+1;
      END   "init sample";
   SIMPLE PROCEDURE draw(
         INTEGER id;
         REFERENCE REAL sample;
         REFERENCE INTEGER x_displacement;
         REAL y_scale);
      BEGIN "draw"
      INTEGER screen_y;
      x_displacement ← x_displacement+1;
      IF
         sample = 0
       THEN
         RETURN;
      screen_y ← sample*y_scale;
      RIVECT(id,x_displacement,screen_y);
      RVECT(id,0,-screen_y);
      x_displacement ← 0;
      sample ← 0;
      END   "draw";
   PROCEDURE init_draw(
         INTEGER id;
         RECORD_POINTER(CASCADE) rev;
         REAL x_lo, y_lo, x_hi, y_hi,
            decay, scale;
         REFERENCE INTEGER x_displacement;
         REFERENCE REAL y_scale);
      BEGIN "init draw"
      REAL y_offset, x_offset, x_scale;
      RECORD_POINTER(REV_STATE_LIST) rev_chain;
      INTEGER pos, wid, dig;

      AXIS(id,0.0,scale,y_scale,y_offset,x_lo,y_lo,y_hi,FALSE);
      AXIS(id,0.0,decay,x_scale,x_offset,y_lo,x_lo,x_hi,TRUE);
      IF
         rev ≠ NULL_RECORD
       THEN BEGIN "list units"
	 rev_chain ← CASCADE:FIRST_UNIT[rev];
	 pos ← TEXT_ROW;
	 AIVECT(id,TEXT_COL,pos);
         GETFORMAT(wid,dig);
         SETFORMAT(0,0);
	 DTEXT(id,CVS(CASCADE:CLOCK_RATE[rev])&"/sec");
	 WHILE
	    rev_chain ≠ NULL_RECORD
	  DO BEGIN
	    AIVECT(id,TEXT_COL,pos ← pos-PER_LINE);
            SETFORMAT(4,3);
	    DTEXT(id,CVS(REV_STATE_LIST:MEM_SIZE[rev_chain])&","&
		  CVF(REV_STATE_LIST:GAIN[rev_chain]));
            rev_chain ← REV_STATE_LIST:NEXT_UNIT[rev_chain];
	    END;
         SETFORMAT(wid,dig);
         END      "list units";
      x_displacement ← 0;
      AIVECT(id,x_lo,y_lo);
      END   "init draw";
∂ Description of display algorithm.
	This algorithm is an adaptation of a line drawing scheme shown
	me by Marc LeBrun.  It is supposed to display (using calls to
	`..._draw') `s' samples from an impulse response generator
	(represented by calls to `..._sample') in the display space of
	`d' display coordinates, where generally `s' is much larger than
	`d'.  The central idea is that the product of `s' and `d' can be
	obtained as either `s' repetitions of `d' or `d' repetitions of
	`s'.  If `s' and `d' have no factors in common, then the first
	time repetitions of them will equal the same number is when that
	number is their product, thus giving a simple test for
	termination.  By keeping two sums, one for `s' and one for `d',
	and incrementing the smaller as well as performing the
	associated action (increment by `s' and draw or increment by `d'
	and sample) exactly the right number of samples can be displayed
	in the given space with proper scaling.  The actual sample
	displayed at a given coordinate is chosen to be the one with the
	largest absolute value since the last time a sample was
	displayed.  It is not really necessary to maintain two counts
	if, say, `s' increments a counter and `d' decrements it, because
	then a simple comparison of the counter with zero yields the
	necessary information as to which operation to perform next.  A
	picture might clarify things a little:

			s	s	s	s	s
		|	|	|	|	|	|
		|    |    |    |    |    |    |    |    |
		     d    d    d    d    d    d    d    d

	Here, `s' indicates where to increment by `s' and draw, and
	`d' of course indicates where to decrement by `d' and sample.
	All the samples between the s's are displayed together.  In this
	particular case there are 8 samples and 5 spaces to put them.
;
   INTEGER s,d,q,
      index,
      x_displacement;
   REAL big,
      scale,
      y_scale;
   RECORD_POINTER(REV_STATE_LIST) state;

   IF
      id = 0
    THEN
      DGET(id,2500)
    ELSE
      BUFCLR(id,2500);

   init_sample(rev_chain,
         scale,
         state,index);
   init_draw(id,
         rev_chain,
         lo_x,lo_y,hi_x,hi_y,
         duration,scale,
         x_displacement,y_scale);

   IF
      rev_chain = NULL_RECORD
    THEN
      RETURN;

   big ← 0.0;
   d ← DISPLAY_WIDTH;
   s ← duration*CASCADE:CLOCK_RATE[rev_chain];
   IF
      (s MOD d) = 0
    THEN
      s ← s+1;
   q ← s-d;
   WHILE
      q ≠ 0
    DO BEGIN
      WHILE
         q > 0
       DO BEGIN
         next_sample(big,state,index);
         q ← q-d;
         END;
      WHILE
         q < 0
       DO BEGIN
         draw(id,big,x_displacement,y_scale);
         q ← q+s;
         END;
      END;
   next_sample(big,state,index);
   draw(id,big,x_displacement,y_scale);
   END   "impuls";
END   "IMPULSE"